home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue50 / Clinic / ClipHelp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-16  |  2.7 KB  |  105 lines
  1. unit ClipHelp;
  2.  
  3. interface
  4.  
  5. uses
  6.   Classes;
  7.  
  8. const
  9.   CF_COMPONENTS: Word = 0;
  10.  
  11. procedure ClipBoardGetComponents(Owner, Parent: TComponent);
  12. procedure ClipBoardSetComponents(Components: array of TComponent);
  13.  
  14. implementation
  15.  
  16. uses
  17.   ClipBrd, WinTypes, WinProcs, SysUtils, Controls;
  18.  
  19. procedure ClipBoardSetComponents(Components: array of TComponent);
  20. var
  21.   ClipStream: TMemoryStream;
  22.   Loop: Integer;
  23.   Data: THandle;
  24.   DataPtr: Pointer;
  25. begin
  26.   ClipStream := TMemoryStream.Create;
  27.   try
  28.     for Loop := Low(Components) to High(Components) do
  29.       ClipStream.WriteComponent(Components[Loop]);
  30.     { Reset stream pointer to beginning }
  31.     ClipStream.Position := 0;
  32.     { Allocate memory block to give to clipboard }
  33.     Data := GlobalAlloc(GMEM_MOVEABLE and GMEM_DDESHARE, ClipStream.Size);
  34.     if Data = 0 then
  35.       OutOfMemoryError;
  36.     { Lock it for writing }
  37.     DataPtr := GlobalLock(Data);
  38.     try
  39.       ClipStream.Read(DataPtr^, ClipStream.Size);
  40.     finally
  41.       { Unlock it }
  42.       GlobalUnlock(Data)
  43.     end;
  44.     { Clipboard takes ownership of memory block, so we can forget it }
  45.     ClipBoard.SetAsHandle(CF_COMPONENTS, Data)
  46.   finally
  47.     ClipStream.Free
  48.   end;
  49. end;
  50.  
  51. procedure ClipBoardGetComponents(Owner, Parent: TComponent);
  52. var
  53.   Data: THandle;
  54.   DataPtr: Pointer;
  55.   ClipStream: TMemoryStream;
  56.   Comp: TComponent;
  57. const
  58.   FilerSignature: array[1..4] of Char = 'TPF0';
  59. begin
  60.   ClipBoard.Open;
  61.   try
  62.     Data := GetClipboardData(CF_COMPONENTS);
  63.     if Data = 0 then
  64.       Exit;
  65.     DataPtr := GlobalLock(Data);
  66.     if DataPtr = nil then
  67.       Exit;
  68.     try
  69.       ClipStream := TMemoryStream.Create;
  70.       try
  71.         ClipStream.WriteBuffer(DataPtr^, GlobalSize(Data));
  72.         ClipStream.Position := 0;
  73.         repeat
  74.           { Check for VCL stream signature before proceeding }
  75.           if PLongint(Longint(ClipStream.Memory) + ClipStream.Position)^ <>
  76.              Longint(FilerSignature) then
  77.             Exit;
  78.           Comp := ClipStream.ReadComponent(nil);
  79.           if Comp is TControl then
  80.             TControl(Comp).Parent := Parent as TWinControl;
  81.           try
  82.             Owner.InsertComponent(Comp)
  83.           except
  84.             Comp.Free;
  85.             raise
  86.           end
  87.         { We will probably leave thanks to the signature }
  88.         { before check this condition is met as Windows }
  89.         { memory is rounded up in size, so there will be slack }
  90.         until ClipStream.Position = ClipStream.Size
  91.       finally
  92.         ClipStream.Free
  93.       end
  94.     finally
  95.       GlobalUnlock(Data)
  96.     end
  97.   finally
  98.     ClipBoard.Close
  99.   end
  100. end;
  101.  
  102. initialization
  103.   CF_COMPONENTS := RegisterClipboardFormat('Delphi Components');
  104. end.
  105.